PC-Blue - MS DOS Public Domain Library

home *** CD-ROM | disk | FTP | other *** search

/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol136 / checkprt.bas < prev next >

Wrap

BASIC Source File | 1986-12-15 | 17.7 KB | 359 lines

4000 COLOR 7,0: REM **************************************************************************************************** 4010 REM "CHECKPRT" SUBROUTINE TO PRINT CHECKS AND UPDATE THE CHECK DISKETTE RECORDS 4020 REM ************************************************************************************************************** 4030 GOSUB 260 'OPEN FILES #1,#2,#3 4040 REM ************************************************************************************************************** 4050 REM THE FOLLOWING ARRAY 'B$()' IS USED TO PRINT NUMBERS AS WORDS 4060 REM ************************************************************************************************************** 4070 B$(2) = "TWENTY" 4080 B$(3) = "THIRTY" 4090 B$(4) = "FORTY" 4100 B$(5) = "FIFTY" 4110 B$(6) = "SIXTY" 4120 B$(7) = "SEVENTY" 4130 B$(8) = "EIGHTY" 4140 B$(9) = "NINETY" 4150 B$(10) = "ONE" 4160 B$(11) = "TWO" 4170 B$(12) = "THREE" 4180 B$(13) = "FOUR" 4190 B$(14) = "FIVE" 4200 B$(15) = "SIX" 4210 B$(16) = "SEVEN" 4220 B$(17) = "EIGHT" 4230 B$(18) = "NINE" 4240 B$(19) = "TEN" 4250 B$(20) = "ELEVEN" 4260 B$(21) = "TWELVE" 4270 B$(22) = "THIRTEEN" 4280 B$(23) = "FOURTEEN" 4290 B$(24) = "FIFTEEN" 4300 B$(25) = "SIXTEEN" 4310 B$(26) = "SEVENTEEN" 4320 B$(27) = "EIGHTEEN" 4330 B$(28) = "NINETEEN" 4340 ' 4350 REM ************************************************************************************************************** 4360 J = 1 'USE CKNO%(J) ARRAY TO STORE RECORD # FOR PRINTING MAILING LABELS AFTER PRINTING ALL CHECKS 4370 CKNO%(J) = 9999 'LAST ARRAY ENTRY 4380 REM ************************************************************************************************************** 4390 REM WRITE BANK STATEMENT CHECKS AMOUNT ISSUED FIELD TO ACTIVITY LOG FILE 'BEFORE' IT IS UPDATED 4400 REM ************************************************************************************************************** 4410 GOSUB 7300 'GET BANK STATEMENT FILE #1 RECORD 4420 TC$="40" 4430 CN%=0 4440 AC$=SPACE$(1) 4450 TD$=SPACE$(8) 4460 PA%=1 4470 PC$=P1$ 4480 PA$=A1$ 4490 TAMT=0 4500 LACTM%=0 4510 LACTS%=0 4520 LAMT=0 4530 BDIW=CVS(S2$) 4540 BAMT=CVS(S3$) 4550 GOSUB 310 'WRITE AUDIT TRAIL RECORD 4560 REM ************************************************************************************************************** 4570 GOSUB 300 'GET PAYEE'S FILE #1 AND FILE #2 DISKETTE RECORDS 4580 IF ASC(F1$)<>255 THEN GOTO 4630 4590 COLOR 31,0: PRINT " This Payee Record not in use. Retry." 4600 PRINT " Press any key to continue." 4610 IF INKEY$ = "" THEN GOTO 4610 4620 COLOR 7,0: GOTO 4570 4630 IF P1$=P2$ THEN GOTO 4680 4640 COLOR 31,0: PRINT " Payee Numbers are unequal": COLOR 7,0 4650 PRINT " File #1 is ";P1$ 4660 PRINT " File #2 is ";P2$ 4670 GOTO 330 'CANCEL PROGRAM 4680 CHEKD1$ = D1$ 'FOR CHECK PRINTING 4690 CHEKP1$ = P1$ 'FOR CHECK PRINTING 4700 CHEKA1$ = A1$ 'FOR CHECK PRINTING - PAYEE NAME 4702 CHEKA2$ = A2$ 'FOR CHECK PRINTING - PAYEE ADDRESS 4704 CHEKA3$ = A3$ 'FOR CHECK PRINTING - PAYEE CITY AND STATE 4706 CHEKA4$ = A4$ 'FOR CHECK PRINTING - PAYEE ZIPCODE 4710 PREC% = REC% 'SAVE 1ST RECORD ADDRESS FOR CHECK PRINTING 4720 SVADDRS% = REC% 'SAVE FOR 'L$' FIELD UPDATE 4730 SAVEP2$ = P2$ 'SAVE PAYEE CODE 4740 CLS 4750 PRINT: COLOR 7,0: PRINT " Enter Check No., Amount and Date" 4760 PRINT: PRINT " (Enter a date only if Check's date" 4770 PRINT " is to be other than today's date.)": PRINT 4780 PRINT " Dated examples are:" 4790 PRINT " Future: 2912 1077.52 03-03-99" 4800 TDATE$ = SPACE$(8): LSET TDATE$ = DATE$: YR$ = MID$(DATE$,9,2): MID$(TDATE$,7,2) = YR$ 4810 PRINT " Today's: 2912 1077.52 ";TDATE$ 4820 CHEKDATA$ = SPACE$(22) 4830 PRINT: PRINT SPC(12);: Y = CSRLIN: X = POS(0) 4840 FIELDMAX% = 4: NUM.ONLY% = TRUE%: DEC.MINUS% = FALSE% 4850 GOSUB 320 4855 IF DATU$ = "" THEN GOTO 6830 'PRINT MAILING LABELS, IF ANY 4860 CHECKNO$ = DATU$ 4870 X = X + 6 'ADJUST CURSOR COLUMN 4880 FIELDMAX% = 8: NUM.ONLY% = TRUE%: DEC.MINUS% = TRUE% 4890 GOSUB 320 4900 CHECKAMT$ = DATU$ 4910 AMT = VAL(DATU$) 4920 LOCATE Y,X+1: COLOR 0,7 4930 PRINT USING "#####.##";AMT: COLOR 7,0 4940 X = X + 11 'ADJUST CURSOR COLUMN 4950 FIELDMAX% = 8: NUM.ONLY% = TRUE%: DEC.MINUS% = TRUE% 4960 GOSUB 320 4970 IF DATU$<>"" THEN TDATE$ = DATU$ 4980 CHEKDATA$ = CHECKNO$ + " " + CHECKAMT$ + " " + TDATE$ 4990 IF CHEKDATA$ = "" THEN GOTO 6830 'PRINT MAILING LABELS, IF ANY 5000 IF LEN(CHEKDATA$) < 7 THEN COLOR 31,0: PRINT " Incorrect input, Reenter your data.": GOTO 4820 5010 SLOC = INSTR(CHEKDATA$,SPACE$(1)) 5020 ICHEKNO$ = LEFT$(CHEKDATA$,SLOC-1) 5030 ICHEK% = VAL(ICHEKNO$) 'CHECK NO. 5040 DEC$ = "." 5050 XLOC = INSTR(SLOC+1,CHEKDATA$,DEC$) 'FIND DECIMAL POSITION 5055 IF XLOC = 0 THEN GOTO 4740 5060 ' 5070 DOLLAR$ = MID$(CHEKDATA$,SLOC+1,XLOC-(SLOC+1)) 5080 DLEN = LEN(DOLLAR$) 5090 DOLLARS = VAL(DOLLAR$) 'DOLLARS ONLY 5100 ' 5110 CENT$ = MID$(CHEKDATA$,XLOC+1,2) 5120 CENTS = VAL(CENT$) 'CENTS ONLY 5130 ' 5140 AMT$ = MID$(CHEKDATA$,SLOC+1,XLOC-(SLOC-2)) 5150 AMT = VAL(AMT$) 5160 ' 5170 IF MID$(CHEKDATA$,XLOC+4,8) = "" THEN TDATE$ = SPACE$(8): ELSE TDATE$ = MID$(CHEKDATA$,XLOC+4,8) 5180 COLOR 7,0: PRINT: PRINT: PRINT " Check No. is: ";ICHEK% 5190 PRINT USING " Check amt. is: #####,.##";AMT 5200 PRINT " Check date is: ";TDATE$ 5210 PRINT " Payee: ";A1$ 5220 PRINT: COLOR 0,7: PRINT " Are you sure? Reply Y or N. "; 5230 C$ = INKEY$: IF C$="" THEN 5230 5240 PRINT C$: COLOR 7,0: IF C$ = "N" OR C$ = "n" THEN GOTO 4740 5250 IF C$ = "Y" OR C$ = "y" THEN GOTO 5300 5260 COLOR 31,0: PRINT " I need a Y or N";: GOTO 5230 5270 REM ************************************************************************************************************** 5280 REM TEST CHECK NO. FIELD FOR ZEROS TO FIND NEXT SLOT FOR ENTERING THIS CHECK 5290 REM ************************************************************************************************************** 5300 GOSUB 270 'READ CHECK FIELDS TO ARRAY 5310 FOR I = 1 TO 8 5320 IF CHEK1%(I) = 0 THEN GOTO 5620 5330 NEXT I 5340 REM ************************************************************************************************************** 5350 REM TEST CHAINING FIELD TO GET LAST FILE #2 RECORD IN THIS PAYEE'S CHAIN 5360 REM ************************************************************************************************************** 5370 CHANE% = CVI(L$) 5380 IF CHANE% = 0 THEN GOTO 5520 5390 IF (CHANE%>M1%) AND (CHANE%<(M2%+1)) THEN GOTO 5450 5400 COLOR 7,0: PRINT " Chaining record error on Payee ";P2$ 5410 PRINT USING " Chaining field is ####";CHANE% 5420 PRINT " Valid chaining records are ";M1%+1;"-";M2% 5430 COLOR 31,0: PRINT " Correct File before rerunning this job": COLOR 7,0 5440 GOTO 330 'ERROR ON FILE, DO NOT CONTINUE 5450 GET #2,CHANE% 5460 SVADDRS% = CHANE% 5470 IF P1$=P2$ THEN GOTO 5300 5480 COLOR 31,0: PRINT " Chaining Payee No. is unequal": COLOR 7,0 5490 PRINT " FILE #1 Payee No. is ";P1$ 5500 PRINT " FILE #2 Payee No. is ";P2$ 5510 GOTO 330 'ERROR ON FILE, DO NOT CONTINUE 5520 GOSUB 290 'CREATE NEXT FILE #2 RECORD FOR THIS PAYEE 5530 GET #1,PREC% 'RE-GET PAYEE FILE #1 RECORD 5540 IF P2$=P1$ THEN GOTO 5300 5550 COLOR 31,0: PRINT " Payee Numbers are unequal": COLOR 7,0 5560 PRINT " FILE #1 is ";P1$ 5570 PRINT " FILE #2 is ";P2$ 5580 GOTO 330 'ERROR ON FILE, DO NOT CONTINUE 5590 REM ************************************************************************************************************** 5600 REM UPDATE PAYEE FILE #2 RECORD WITH THIS CHECK INFORMATION 5610 REM ************************************************************************************************************** 5620 CHEK1%(I) = ICHEK% 5630 CHEK2$(I) = SPACE$(1) 5640 CHEK3$(I) = TDATE$ 5650 CHEK4(I) = AMT 5660 GOSUB 280 'MOVE CHECK DATA ARRAY TO THE I/O BUFFER OF FILE #2 5670 PUT #2,SVADDRS% 5680 REM ************************************************************************************************************** 5690 REM WRITE 'CHECK ISSUED' TRANSACTION TO THE ACTIVITY LOG FILE 5700 REM ************************************************************************************************************** 5710 TC$="41" 5720 CN%=CHEK1%(I) 5730 AC$=SPACE$(1) 5740 TD$=CHEK3$(I) 5750 PA%=SVADDRS% 5760 PC$=P2$ 5770 PA$=CHEKA1$ 5780 TAMT=CHEK4(I) 5790 BDIW=0 5800 BAMT=0 5810 IF BOOKS$="Y" THEN GOTO 5870 5820 GOSUB 310 'EXECUTED ONLY IF NOT USING THE SIMPLE BOOKKEEPING SYSTEM OPTION 5830 GOTO 6160 5840 REM ************************************************************************************************************** 5850 REM DISTRIBUTE CHECK AMOUNT TO THE SIMPLE BOOKKEEPING SYSTEM ACCOUNTS 5860 REM ************************************************************************************************************** 5870 T=AMT 'CHECK AMOUNT TO DISTRIBUTE BY ACCOUNT NUMBERS 5880 CLS 5890 COLOR 7,0: PRINT " Enter Account Numbers and Amounts" 5900 PRINT " For BOOKKEEPING SYSTEM" 5910 PRINT: PRINT USING " Transaction Amount is: #####,.##-";T 5920 PRINT " Enter the following:" 5930 PRINT " Major Account #: ";: Y = CSRLIN: X = POS(0) 5940 FIELDMAX% = 4: NUM.ONLY% = TRUE%: DEC.MINUS% = FALSE%: GOSUB 320 5950 IF DATU$ = "" THEN GOTO 5930 5960 IF LEN(DATU$)<>4 THEN COLOR 31,0: PRINT " Account is a 4 digit code, retry": COLOR 7,0: GOTO 5930 5970 LACTM% = VAL(DATU$) 5990 PRINT: PRINT SPC(12);"Record Number: ";: Y = CSRLIN: X = POS(0) 6000 FIELDMAX% = 3: NUM.ONLY% = TRUE%: DEC.MINUS% = FALSE%: GOSUB 320 6010 IF DATU$ = "" THEN GOTO 5990 6020 LACTS% = VAL(DATU$) 6030 IF LACTS% > 0 AND LACTS% < (M10% + M11% + 1) THEN GOTO 6050 6040 COLOR 31,0: PRINT " Enter a valid Record Number": COLOR 7,0: GOTO 5990 6050 PRINT: PRINT " Amount for this Account: ";: Y = CSRLIN: X = POS(0) 6060 FIELDMAX% = 9: NUM.ONLY% = TRUE%: DEC.MINUS% = TRUE%: GOSUB 320 6070 IF DATU$ = "" THEN GOTO 6050 6080 LAMT = VAL(DATU$) 6100 LOCATE Y,X+1: COLOR 0,7 6110 PRINT USING "#####.##-";LAMT: COLOR 7,0 6120 GOSUB 310 'WRITE AUDIT TRAIL RECORD TO ACTIVITY LOG FILE 6125 Y = CSRLIN: IF Y > 18 THEN CLS 6130 T = T - LAMT 6140 IF ABS(T) > (8.999999E-03) THEN TAMT=0: PRINT USING " Undistributed amount is: #####,.##-";T: GOTO 5910 6150 REM ************************************************************************************************************** 6160 IF G2$<>"N" THEN GOTO 6190 6170 CKNO%(J) = PREC% 'SAVE PAYEE RECORD NO. FOR MAILING LABEL PRINTING 6180 J = J + 1: CKNO%(J) = 9999 6190 GOSUB 7300 'GET BANK STATEMENT RECORD AND UPDATE IT 6200 T = CVS(S3$) 6210 T = T + AMT 6220 RSET S3$ = MKS$(T) 6230 T = CVS(S4$) 6240 T = T - AMT 6250 IF T > 0 THEN GOTO 6290 6260 BEEP: BEEP: COLOR 31,0 'BLINK AND HIGHLIGHT 6270 PRINT USING " OVERDRAWN BY ######,.##";T 6280 COLOR 7,0 6290 RSET S4$ = MKS$(T) 6300 CHK% = CVI(S6$) 'COUNT OF NUMBER OF CHECKS ISSUED 6310 CHK% = CHK% + 1 'INCREMENT CHECK COUNT 6320 RSET S6$ = MKI$(CHK%) 6330 PUT #1,1 'PUT BANK STATEMENT RECORD BACK TO DISKETTE 6340 GOSUB 7300 'TO ASSURE THE LAST I/O BUFFER WRITE TO DISK IN CASE OF PRINTER FAILURE AND PROGRAM ABORTS 6350 PRINT: COLOR 0,7: PRINT " Is CHECK printer alignment OK?": BEEP 6360 PRINT " Press 'R' key when ready": COLOR 7,0 6370 C$ = INKEY$: IF C$ = "" THEN GOTO 6370 6375 IF C$ = "R" OR C$ = "r" THEN GOTO 6410 ELSE GOTO 6360 6380 REM ************************************************************************************************************** 6390 REM PRINT THE CHECK 6400 REM ************************************************************************************************************** 6410 LPRINT CHR$(27);"E"; 'TURN ON EMPHASIZED PRINT 6420 LPRINT TAB(29);CHEKD1$: LPRINT 'PRINT IDENTIFICATION DATA LINE 6430 LPRINT: LPRINT TAB(37); TDATE$ 'PRINT DATE LINE 6440 LPRINT: LPRINT TAB(45); 6450 LPRINT USING "**#####,.##";AMT 'PRINT AMOUNT LINE 6460 LPRINT CHR$(14); 'TURN ON ENLARGED PRINT 6490 IF DLEN<3 THEN LPRINT " * * *";: GOTO 6550 6500 Y$="0": IF DLEN=3 THEN IF INSTR(DOLLAR$,Y$) = 0 THEN LPRINT " * * *";: GOTO 6520 6510 IF DLEN=3 THEN LPRINT " ";: GOTO 6550 6520 LPRINT CHR$(20); 'TURN OFF ENLARGED PRINT 6530 LPRINT CHR$(27) "F"; 'TURN OFF EMPHASIZED PRINT 6540 LPRINT CHR$(15) CHR$(14) " "; 'TURN ON CONDENSED AND ENLARGED PRINT 6550 GOSUB 6750 'CONVERT AND PRINT NUMBERS TO WORDS (DOLLARS ONLY) 6560 LPRINT CHR$(20) "AND "; 'TURN OFF ENLARGED PRINT 6570 IF CENTS=0 THEN LPRINT "NO/100 DOLLARS": GOTO 6591 6580 LPRINT USING "##";CENTS; 'PRINT CENTS 6590 LPRINT "/100 DOLLARS" 6591 LPRINT CHR$(18); CHR$(27) "E": LPRINT TAB(7); CHEKA1$ 'TURN OFF CONDENSED PRINT, TURN ON EMPHASIZED PRINT, PRINT PAYEE NAME 6592 LPRINT TAB(7); CHEKA2$ 'PRINT PAYEE ADDRESS 6593 FOR MI% = 21 TO 10 STEP -1 6594 IF MID$(CHEKA3$,MI%,1) <> " " THEN GOTO 6596 6595 NEXT 6596 MI% = MI% + 1 6597 CHEKA3A$ = LEFT$(CHEKA3$,MI%) 6598 LPRINT TAB(7); CHEKA3A$; 'PRINT PAYEE CITY AND STATE 6599 A4A$=LEFT$(CHEKA4$,5) 6600 A4B$=RIGHT$(CHEKA4$,4) 6606 LPRINT " ";A4A$; 'PRINT ZIP CODE 6607 IF A4B$<>SPACE$(4) THEN LPRINT "-";A4B$ ELSE LPRINT 6608 LPRINT: LPRINT TAB(7); 6610 LPRINT CHR$(18) "REF: ";CHEKP1$; 'TURN OFF CONDENSED PRINT, PRINT PAYEE CODE 6620 LPRINT USING " ####";PREC%,ICHEK% 'PRINT PAYEE RECORD NO. AND CHECK NO. 6630 LPRINT CHR$(27);"F" 'TURN OFF EMPHASIZED PRINT 6640 LPRINT: LPRINT: LPRINT: BEEP 'SPACE UP TO NEXT CHECK 6660 PRINT: COLOR 0,7: PRINT " Want to print another Check?" 6670 PRINT " Reply Y or N.";SPC(15); 6680 C$ = INKEY$: IF C$ = "" THEN 6680 6690 PRINT C$: COLOR 7,0: IF C$ = "Y" OR C$ = "y" THEN GOTO 4570 6700 IF C$ = "N" OR C$ = "n" THEN GOTO 7110 6710 GOTO 6660 6720 REM ************************************************************************************************************** 6730 REM ROUTINE TO PRINT NUMBERS AS WORDS 6740 REM ************************************************************************************************************** 6750 IF DOLLARS>999 THEN U=DOLLARS-INT(DOLLARS/1000)*1000:DOLLARS=INT(DOLLARS/1000): GOSUB 6750: LPRINT "THOUSAND ";:DOLLARS = U 6760 IF DOLLARS>99 THEN V=DOLLARS:DOLLARS=INT(DOLLARS/100):GOSUB 6750:LPRINT "HUNDRED ";: DOLLARS=V-DOLLARS*100 6770 IF DOLLARS>19 THEN LPRINT B$(INT(DOLLARS/10));" ";:DOLLARS=DOLLARS-10*INT(DOLLARS/10) 6780 IF DOLLARS THEN LPRINT B$(DOLLARS+9);" "; 6790 RETURN 6800 REM ************************************************************************************************************** 6810 REM PRINT MAILING LABELS FOR PAYEES THAT ARE CODED AS NEEDING ONE 6820 REM ************************************************************************************************************** 6830 IF CKNO%(1) = 9999 THEN GOTO 7060 6832 PRINT " Mailing labels required? Reply Y or N": BEEP 6834 C$ = INKEY$: IF C$ = "" THEN GOTO 6834 6836 IF C$ = "Y" OR C$ = "y" THEN GOTO 6840 6838 IF C$ = "N" OR C$ = "n" THEN GOTO 7060 ELSE GOTO 6832 6840 PRINT: PRINT " Insert mailing labels in printer ": BEEP 6850 PRINT " with print positions 1-30 centered " 6860 PRINT " for printing first line of address." 6870 PRINT: COLOR 0,7: PRINT " Press 'R' key when ready";SPC(11): COLOR 7,0 6880 C$ = INKEY$:IF C$ = "" THEN GOTO 6880 6885 IF C$ = "R" OR C$ = "r" THEN GOTO 6890 ELSE GOTO 6870 6890 WIDTH "LPT1:",80 6900 LPRINT CHR$(27);"E"; 'SET FOR EMPHASIZED PRINTING 6910 FOR J = 1 TO 50 6920 IF CKNO%(J) = 9999 THEN GOTO 7060 'RETURN TO JOB CHOICES 6930 REC% = CKNO%(J) 6940 IF CKNO%(J-1) = CKNO%(J) THEN GOTO 7050 'PRINT ONLY 1 LABEL PER PAYEE 6950 GET #1,REC% 6960 LPRINT A1$ 6970 LPRINT A2$ 6980 LPRINT A3$ 6990 A4A$=LEFT$(A4$,5) 7000 A4B$=RIGHT$(A4$,4) 7010 LPRINT TAB(21);A4A$; 7020 IF A4B$<>SPACE$(4) THEN LPRINT "-";A4B$ ELSE LPRINT 7030 LPRINT 7040 LPRINT 7050 NEXT J 'END OF PRINTING MAILING LABELS LOOP 7060 CLOSE 'CLOSE ALL FILES 7070 GOTO 250 'RETURN TO JOB CHOICES MENU 7080 REM ************************************************************************************************************** 7090 REM WRITE BANK STATEMENT CHECKS AMOUNT ISSUED FIELD TO ACTIVITY LOG FILE 'AFTER' IT IS UPDATED 7100 REM ************************************************************************************************************** 7110 GOSUB 7300 'GET BANK STATEMENT FILE #1 RECORD 7120 TC$="42" 7130 CN%=0 7140 AC$=SPACE$(1) 7150 TD$=SPACE$(8) 7160 PA%=1 7170 PC$=P1$ 7180 PA$=A1$ 7190 TAMT=0 7200 LACTM%=0 7210 LACTS%=0 7220 LAMT=0 7230 BDIW=CVS(S2$) 7240 BAMT=CVS(S3$) 7250 GOSUB 310 7260 GOTO 6830 'PRINT MAILING LABELS 7270 REM ************************************************************************************************************** 7280 REM SUBROUTINE TO GET BANK STATEMENT FILE #1 RECORD 7290 REM ************************************************************************************************************** 7300 GET #1,1 7310 IF F1$="$" THEN GOTO 7360 7320 COLOR 7,0: PRINT " The Bank Statement record has been" 7330 PRINT " overlayed in FILE #1, Record #1" 7340 PRINT " By Payee # ";P1$ 7350 COLOR 31,0: PRINT " Correct File then rerun this job": COLOR 7,0: GOTO 330 7360 RETURN 7370 REM ************************************************************************************************************** 9000 GOTO 9000 'CHAIN MERGE AREA LAST STATEMENT